home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / tex / td187src.lzh / CIRCLES.I < prev    next >
Text File  |  1991-12-14  |  22KB  |  662 lines
  1. IMPLEMENTATION MODULE Circles ;
  2.  
  3. FROM Types     IMPORT TextPosTyp;
  4. IMPORT Types;
  5.  
  6. IMPORT mtAppl;
  7. IMPORT Diverses;
  8. IMPORT MagicAES;
  9. IMPORT MagicVDI;
  10. IMPORT MagicSys;
  11. IMPORT MathLib0 ;
  12.  
  13. IMPORT OwnBoxes;
  14. IMPORT Variablen ;
  15. IMPORT CommonData ;
  16. IMPORT HelpModule;
  17. IMPORT Fill;
  18. IMPORT Undo;
  19.  
  20. TYPE mkMode = (mkQuarter, mkCircle, mkDisk, mkArc, mkEllipse, mkEllArc);
  21.  
  22.  
  23. CONST HorizLines   = 0;
  24.       VertiLines   = 1;
  25.       DiagLftLines = 2;
  26.       DiagRgtLines = 3;
  27.  
  28. PROCEDURE Make ( Mode : mkMode; FillMode : INTEGER ) ;
  29.  
  30. VAR rx , ry , mx, my, rox, roy,
  31.     r, dx1, dx2, dy1, dy2,
  32.     x , y , b , e , bo , eo , xpic, ypic,
  33.     dum, h, mr                : INTEGER ;
  34.     keystate, but             : BITSET ;
  35.     fillstyle, fillstyleindex : INTEGER ;
  36.     xy                        : Types.CodeAryTyp ;
  37.     Surround                  : ARRAY [0..3] OF INTEGER;
  38.     halfcircle                : BOOLEAN;
  39.     lbut, rbut, allok         : BOOLEAN;
  40.     startangle, endangle      : INTEGER;
  41.     xold, yold                : INTEGER;
  42.     hlppos1, hlppos2          : INTEGER;
  43.     HelpAngle1,
  44.     HelpAngle2,
  45.     HelpEllipse,
  46.     HelpQuarter,
  47.     HelpHalf,
  48.     HelpFull                  : ARRAY [0..59] OF CHAR;
  49.  
  50.   PROCEDURE ReplaceAngleVal(VAR str : ARRAY OF CHAR;
  51.                             angleval, strpos : INTEGER);
  52.   VAR dum : INTEGER;
  53.   BEGIN
  54.     IF strpos>0 THEN
  55.       str[strpos]   := CHR(ORD('0') + MagicSys.CastToCard(angleval DIV 100));
  56.       dum := angleval MOD 100;
  57.       str[strpos+1] := CHR(ORD('0') + MagicSys.CastToCard(dum DIV 10));
  58.       str[strpos+2] := CHR(ORD('0') + MagicSys.CastToCard(dum MOD 10));
  59.     END;
  60.   END ReplaceAngleVal;
  61.  
  62.   PROCEDURE NewAngleVal(VAR angle, xold, x   : INTEGER;
  63.                         keystate             : BITSET);
  64.   VAR shift, ctrl, alt : BOOLEAN;
  65.   BEGIN
  66.     shift := (MagicAES.KRSHIFT IN keystate) OR
  67.              (MagicAES.KLSHIFT IN keystate);
  68.     ctrl  := MagicAES.KCTRL IN keystate;
  69.     alt   := MagicAES.KALT IN keystate;
  70.     IF (xold<x) THEN
  71.       IF shift THEN
  72.         DEC(angle, 5);
  73.       ELSIF alt AND NOT ctrl THEN
  74.         (* auf nächst niedrigeren Wert *)
  75.         IF angle = 0 THEN
  76.           angle := -45;
  77.          ELSE
  78.           angle := ((angle-1) DIV 45) * 45;
  79.         END;
  80.       ELSIF ctrl AND NOT alt THEN
  81.         (* auf nächst niedrigeren Wert *)
  82.         IF angle = 0 THEN
  83.           angle := -90;
  84.          ELSE
  85.           angle := ((angle-1) DIV 90) * 90;
  86.         END;
  87.       ELSIF ctrl AND alt THEN
  88.         (* auf nächst niedrigeren Wert *)
  89.         IF angle = 0 THEN
  90.           angle := -180;
  91.          ELSE
  92.           angle := ((angle-1) DIV 180) * 180;
  93.         END;
  94.       ELSE
  95.         DEC(angle, 1);
  96.       END;
  97.      ELSE
  98.       IF shift THEN
  99.         INC(angle, 5);
  100.       ELSIF alt AND NOT ctrl THEN
  101.         (* auf nächst höheren Wert *)
  102.         angle := ((angle DIV 45) +1) * 45;
  103.       ELSIF ctrl AND NOT alt THEN
  104.         (* auf nächst höheren Wert *)
  105.         angle := ((angle DIV 90) +1) * 90;
  106.       ELSIF ctrl AND alt THEN
  107.         (* auf nächst höheren Wert *)
  108.         angle := ((angle DIV 180) +1) * 180;
  109.       ELSE
  110.         INC(angle, 1);
  111.       END;
  112.     END;
  113.     xold := x;
  114.     WHILE (angle>360) DO DEC(angle, 360); END;
  115.     WHILE (angle<  0) DO INC(angle, 360); END;
  116.   END NewAngleVal;
  117.  
  118. BEGIN
  119.   OwnBoxes.WaitForDepress(mx, my);
  120.   Diverses.GetHelpText(6, HelpEllipse);
  121.   Diverses.GetHelpText(6, HelpQuarter);
  122.   Diverses.GetHelpText(7, HelpHalf);
  123.   Diverses.GetHelpText(8, HelpFull);
  124.   Diverses.GetHelpText(9, HelpAngle1);
  125.   Diverses.GetHelpText(10, HelpAngle2);
  126.   hlppos1 := 0;
  127.   WHILE (HelpAngle1[hlppos1]<>0C) AND (HelpAngle1[hlppos1]<>'?') DO
  128.     INC(hlppos1);
  129.   END;
  130.   IF (HelpAngle1[hlppos1  ]<>'?') OR
  131.      (HelpAngle1[hlppos1+1]<>'?') OR
  132.      (HelpAngle1[hlppos1+2]<>'?') THEN
  133.     hlppos1 := -1;
  134.   END;
  135.   hlppos2 := 0;
  136.   WHILE (HelpAngle2[hlppos2]<>0C) AND (HelpAngle2[hlppos2]<>'?') DO
  137.     INC(hlppos2);
  138.   END;
  139.   IF (HelpAngle2[hlppos2  ]<>'?') OR
  140.      (HelpAngle2[hlppos2+1]<>'?') OR
  141.      (HelpAngle2[hlppos2+2]<>'?') THEN
  142.     hlppos2 := -1;
  143.   END;
  144.  
  145.   mr := Variablen.MaxCircle() ;
  146.   IF (Mode = mkDisk) AND (FillMode=0) THEN
  147.     mr := Variablen.MaxDisk() ;
  148.   END ;
  149.   mr := Variablen.PixDistance ( mr );
  150.  
  151.   rox := 0 ;
  152.   roy := 0 ;
  153.   b   := 0 ;
  154.   e   := 3600 ;
  155.   h   := 0 ;
  156.   bo  := 0 ;
  157.   eo  := 3600 ;
  158.  
  159.   MagicVDI.SetLineEndstyles ( mtAppl.VDIHandle , MagicVDI.Cornerd , MagicVDI.Cornerd ) ;
  160.   dum := MagicVDI.SetLinetype ( mtAppl.VDIHandle , MagicVDI.Line ) ;
  161.   dum := MagicVDI.SetLinewidth ( mtAppl.VDIHandle , CommonData.LineWidth ) ;
  162.  
  163.   IF FillMode>=0 THEN
  164.     Fill.SetFillMode(FillMode);
  165.   END;
  166.  
  167.   dum := MagicVDI.SetLinecolor ( mtAppl.VDIHandle , MagicAES.BLACK ) ;
  168.  
  169.   REPEAT
  170.  
  171.     OwnBoxes.GetMKState(x, y, but, keystate);
  172.     OwnBoxes.MousePos(x, y, xpic, ypic, lbut, rbut);
  173.     Variablen.Position (TRUE, x, y, mx, my ) ;
  174.     halfcircle := (MagicAES.KLSHIFT IN keystate) OR
  175.                   (MagicAES.KRSHIFT IN keystate);
  176.     IF NOT ((Mode=mkEllipse) OR (Mode=mkEllArc)) THEN
  177.       rx := Diverses.round ( MathLib0.sqrt (
  178.               MathLib0.real ( x - mx ) * MathLib0.real ( x - mx ) +
  179.               MathLib0.real ( y - my ) * MathLib0.real ( y - my ) ) );
  180.  
  181.       IF rx > mr THEN rx := mr END ;
  182.       ry := rx;
  183.      ELSE
  184.       rx := ABS(x-mx); ry := ABS(y-my);
  185.     END;
  186.  
  187.     IF (rx <> rox) OR (ry <>roy) THEN
  188.  
  189.       IF Mode = mkQuarter THEN
  190.         IF halfcircle THEN
  191.           HelpModule.HelpMessage(HelpHalf);
  192.          ELSE
  193.           HelpModule.HelpMessage(HelpQuarter);
  194.         END;
  195.         IF x - mx < 0 THEN (* linke Seite *)
  196.           IF halfcircle THEN
  197.             IF ABS(y-my)<=ABS(x-mx) THEN
  198.               b := 900; e := 2700;
  199.               h := ORD(Types.Left);
  200.              ELSE
  201.               IF (y-my)<0 THEN       (* Y-Achse invers !! *)
  202.                 b := 0; e := 1800;
  203.                 h := ORD(Types.Top);
  204.                ELSE
  205.                 b := 1800; e := 3600;
  206.                 h := ORD(Types.Bottom);
  207.               END;
  208.             END;
  209.            ELSE
  210.             IF y - my < 0 THEN b :=  900 ; e := 1800 ;
  211.                                h := ORD(Types.LeftTop)  ;
  212.                           ELSE b := 1800 ; e := 2700 ;
  213.                                h := ORD(Types.LeftBot)  ;
  214.             END ;
  215.           END ;
  216.         ELSE (* rechte Seite *)
  217.           IF halfcircle THEN
  218.             IF ABS(y-my)<=ABS(x-mx) THEN
  219.               b := 2700; e := 900;
  220.               h := ORD(Types.Right);
  221.              ELSE
  222.               IF (y-my)<0 THEN       (* Y-Achse invers !! *)
  223.                 b := 0; e := 1800;
  224.                 h := ORD(Types.Top);
  225.                ELSE
  226.                 b := 1800; e := 3600;
  227.                 h := ORD(Types.Bottom);
  228.               END;
  229.             END;
  230.            ELSE
  231.             IF y - my < 0 THEN b :=    0 ; e :=  900 ;
  232.                                h := ORD(Types.RightTop) ;
  233.                           ELSE b := 2700 ; e :=    0 ;
  234.                                h := ORD(Types.RightBot) ;
  235.             END ;
  236.           END ;
  237.         END ;
  238.        ELSIF (Mode = mkEllipse) OR (Mode=mkEllArc) THEN
  239.         HelpModule.HelpMessage(HelpEllipse);
  240.        ELSE
  241.         HelpModule.HelpMessage(HelpFull);
  242.       END ;
  243.  
  244.       dum := MagicVDI.SetWritemode ( mtAppl.VDIHandle , MagicVDI.XOR ) ;
  245.       MagicVDI.SetClipping ( mtAppl.VDIHandle , CommonData.ClipXY , TRUE) ;
  246.       Diverses.MouseOff;
  247.       CASE Mode OF
  248.        mkDisk:
  249.          Fill.SetFillMode(FillMode);
  250.          MagicVDI.Circle ( mtAppl.VDIHandle , mx , my , rox ) ;
  251.          MagicVDI.Circle ( mtAppl.VDIHandle , mx , my , rx ) ;
  252.          Fill.SetFillMode(-1); |
  253.        mkEllArc,
  254.        mkEllipse:
  255.         IF FillMode>=0 THEN
  256.           Fill.SetFillMode(FillMode);
  257.           MagicVDI.Ellipse ( mtAppl.VDIHandle , mx , my , rox, roy);
  258.           MagicVDI.Ellipse ( mtAppl.VDIHandle , mx , my , rx, ry);
  259.          ELSE
  260.           MagicVDI.EllipticalArc ( mtAppl.VDIHandle , mx , my , rox, roy, bo, eo);
  261.           MagicVDI.EllipticalArc ( mtAppl.VDIHandle , mx , my , rx, ry,